0 REM *** KEYDEF: A KEYBOARD REDEFINITION PROGRAM FOR THE COMMODORE 64 ***
1 REM *** WILLIAM R FRENCHU, 106 B NASSAU ST.,PRINCETON NJ. 23.AUG 83 ***
2 REM *** INITIALIZATION ***
3 POKE 53280,PEEK(53281)
4 GOSUB 20000:PRINT "             LOADING DATA"
5 DIM D(194):GOSUB 5400:REM *** LOAD DVORAK DATA ***
6 GOSUB 6000:REM *** LOAD AND RUN SWAP ROUTINE ***
7 F1=1:REM *** SET F1 TO 0 FOR TAPE USE ***
8 IF F1=0 THEN 10
9 OPEN 15,8,15
10 DIM SA(3):REM *** STARTING ADDRESSES FOR KEY TABLES ***
20 SA(0)=60289:SA(1)=60354:SA(2)=60419:SA(3)=60536
30 DIM K$(255):GOSUB 10000:REM *** KEY LABELS ***
90 DIM OK(255),NK(255):REM *** OLD AND NEW KEY ARRAYS ***
117 DIM NE$(66):GOSUB 10500:REM *** NON ECHOING CHARACTERS ***
118 POKE 649,1:REM *** CHANGE KEYBOARD BUFFER LENGTH ***
119 :
120 GOSUB 20000:REM *** MAIN MENU ***
130 PRINT "                MENU 1"
140 PRINT "      1    LOAD DEFINITION FILE"
150 PRINT "      2    CREATE DEFINITION FILE"
170 PRINT "      3    SAVE DEFINITION FILE"
180 PRINT "      4    LOAD DVORAK KEYSET"
190 PRINT "      5    END PROGRAM"
200 PRINT "              OPTION? ";
209 GET A$
210 GET A$:IF A$<"1" OR A$>"5" THEN 210
220 PRINT A$:FOR I=0 TO 1000:NEXT
230 ON VAL(A$) GOTO 1000,2000,4000,5000,3000
998 :
999 :
1000 GOSUB 20000:REM *** LOAD AN EXISTING DEFINITION FILE ***
1009 GET A$
1010 INPUT "  FILENAME";NF$
1015 IF F1=0 THEN 1200
1020 NF$=NF$+",S,R"
1100 OPEN 8,8,8,NF$:REM *** DISK SECTION ***
1110 GOSUB 30000
1120 FOR I=0 TO 3
1122 FOR J=0 TO 63:L=64*I+J:INPUT#8,OK(L):POKE(SA(I)+J),OK(L):NEXT
1124 NEXT
1130 GOSUB 30000
1140 CLOSE 8
1150 GOTO 120
1200 OPEN 1,1,0,NF$ :REM *** TAPE SECTION ***
1220 FOR I=0 TO 3
1222 FOR J=0 TO 63:L=64*I+J:INPUT#1,OK(L):POKE(SA(I)+J),OK(L):NEXT
1224 NEXT
1240 CLOSE 1
1243 PRINT "        HIT ANY KEY TO CONTINUE"
1244 GET A$
1246 GET A$:IF A$="" THEN 1246
1250 GOTO 120
1997 :
1998 :
1999 REM *** CREATE NEW DEFINITION FILE ***
2000 POKE 788,52:REM *** DISABLE STOP KEY ***
2010 GOSUB 20000
2020 PRINT "                MENU 2"
2022 PRINT "   1    ASSIGN SHIFTS INDEPENDENTLY"
2024 PRINT "   2    ASSIGN SHIFTS SIMULTANEOUSLY"
2026 PRINT "              OPTION? ";
2027 GET A$
2028 GET A$:IF A$<"1" OR A$>"2" THEN 2028
2029 REM *** DELAY LOOP ***
2030 PRINT A$:FOR I=0 TO 1000:NEXT
2032 F=VAL(A$)-1:REM *** FLAG FOR ASSIGNING SHIFTED KEYS SIMULTANEOUSLY ***
2035 GOSUB 20000
2039 REM *** LOAD EXISTING DEFS INTO ARRAY ***
2040 PRINT "      LOADING CURRENT DEFINITIONS"
2100 FOR I=0 TO 3
2110 FOR J=0 TO 63:L=64*I+J:OK(L)=PEEK(SA(I)+J):NK(L)=OK(L):NEXT
2115 NEXT
2200 GOSUB 20000
2210 PRINT "   S[146] = SHIFT: C[146] = CTRL: C=[146] = COMMODORE"
2220 PRINT " PRESS STOP[146] TO EXIT OR ENTER CHR$ CODES"
2230 PRINT " [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
2240 PRINT "    KEY ";TAB(20);"ASSIGNMENT"
2250 PRINT "   LABEL";TAB(17);"CURRENT";TAB(29);"NEW"
2260 PRINT " [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
2300 FOR I=0 TO 14
2305 IFPEEK(197)<>64 THEN2305
2306 PRINT"    [146]";
2307 IF F>1 THEN F=1
2310 K=PEEK(197):IF K=64 THEN 2310 :REM *** GET KEY NUMBER ***
2315 IF K=63 THEN 2600:REM *** STOP KEY? ***
2317 IF F=1 THEN J=0:GOTO 2330
2320 J=PEEK(653):IF J>4 THEN 2310:REM *** SHIFTED OR NOT ***
2325 GET A$:GET A$:IF J=4 THEN J=3
2330 L=64*J+K:REM *** INDEX FOR KEY ARRAY ***
2335 IF F=1 THEN PRINT "[157][157][157]*  ";
2340 IF OK(L)>32 GOTO 2345:REM *** CHECK FOR NON ECHOING CHARS ***
2343 PRINT "[157]";K$(L);TAB(18);NE$(OK(L));
2344 GOTO 2360
2345 IF OK(L)<128 OR OK(L)>160 GOTO 2350:REM ***CHECK FOR NON ECHOING CHARS ***
2347 PRINT "[157]";K$(L);TAB(18);NE$(OK(L)-95);
2348 GOTO 2360
2350 IFOK(L)<>34THEN2355
2352 PRINT "[157]";K$(L);TAB(18);NE$(66);
2354 GOTO2360
2355 PRINT "[157]";K$(L);TAB(18);CHR$(OK(L));
2360 IFPEEK(197)<>64THEN2360
2365 PRINT TAB(28);" [146]";
2370 K=PEEK(197):IF K=64 THEN 2370:REM *** GET KEY NUMBER OF NEW ASSIGNMENT ***
2380 IF K=63 AND F=0 THEN 2500:REM *** NEW ASSIGNMENT IS A CHR CODE ***
2382 IF K=63 THEN 2370:REM *** CANT REASSIGN STOP KEY ***
2385 IF F>0 THEN 2410 :REM *** ARE WE ASSIGNING THEM ALL AT ONCE? ***
2400 J=PEEK(653):IF J>4 THEN 2370:REM *** CHECK SHIFT ***
2405 GET A$:GET A$:IF J=4 THEN J=3
2407 REM *** GET NEW DEFINITION ***
2409 REM *** ASSIGNMENT SECTION FOR CHR CODES ***
2410 POKE 1,(PEEK(1)OR2):L1=PEEK(SA(J)+K):POKE 1,(PEEK(1)AND253)
2411 IF F>1 THEN 2430
2412 IF L1>32 GOTO 2415:REM *** CHECK FOR NON ECHOING CHARS ***
2413 PRINT "[157]";NE$(L1)
2414 GOTO 2430
2415 IF L1<128 OR L1>160 GOTO 2420
2416 PRINT "[157]";NE$(L1-95)
2417 GOTO 2430
2420 IF L1<>34 THEN2428
2422 PRINT "[157]";NE$(66)
2424 GOTO 2430
2428 PRINT "[157]";CHR$(L1)
2430 NK(L)=L1
2432 REM *** IF ALL SHIFTS ARE BEING ASSIGNED AT ONCE REPEAT ASSIGNMENT LOOP **
2435 IF F>0 AND J<3 THEN J=J+1:F=F+1:L=L+64:GOTO 2410
2450 IFPEEK(197)<>64THEN2450
2460 NEXT:GOTO 2200
2500 PRINT "[157][157]CHR$(       [157][157][157][157][157][157][157]";
2505 GET A$
2510 INPUT L1
2520 IF L1<0 OR L1>255 THEN PRINT"[157][157][157][157][157][157][157][157][157][157][157]"TAB(29);:GOTO 2500
2530 PRINT "[145]";TAB(32);L1;"[157])"
2540 GOTO 2430
2597 REM *** STOP KEY HAS BEEN PRESSED ***
2598 REM *** STORE THE NEW DEFINITIONS INTO KEYBOARD TABLE AND RETURN TO MAIN
2599 REM MENU SO WE CAN EXIT, SAVE OR MODIFY SOME MORE ***
2600 GOSUB 20000
2602 PRINT TAB(6);"STORING NEW SET IN KEY TABLE"
2605 FOR I=0 TO 3
2610 FOR J=0 TO 63:POKE(SA(I)+J),NK(64*I+J):NEXT
2620 NEXT
2625 POKE 788,49:REM *** RE-ENABLE STOP KEY ***
2630 GOTO 120
2997 :
2998 :
2999 REM *** ROUTINE FOR EXITING ***
3000 GOSUB 20000
3120 PRINT "                MENU 3"
3130 PRINT "   1    RESTORE ORIGINAL DEFINITIONS"
3150 PRINT "   2    RETAIN CURRENT DEFINITIONS"
3160 PRINT "              OPTION? ";
3170 GET A$
3210 GET A$:IF A$<"1" OR A$>"2" THEN 3210
3220 PRINT A$:FOR I=0 TO 1000:NEXT:REM *** DELAY LOOP ***
3225 POKE 649,10:REM *** RESTORE KEYBOARD BUFFER TO NORMAL LENGTH ***
3230 ON VAL(A$) GOTO 3300,3400
3299 REM *** TO RESTORE ORIGINAL SET, BANK ROM BACK IN ***
3300 GOSUB 20000
3310 PRINT "        ORIGINAL KEYSET RESTORED"
3320 POKE 1,(PEEK(1)OR2):CLOSE 15:END
3400 GOSUB 20000
3405 REM *** ELSE, JUST END ***
3410 PRINT "        CURRENT KEYSET RETAINED"
3420 CLOSE 15:END
3997 :
3998 :
3999 REM *** ROUTINE FOR SAVING DEFINITION SET ***
4000 GOSUB 20000
4005 GET A$
4010 INPUT "  FILENAME";NF$
4015 IF F1=0 THEN 4200
4020 NF$=NF$+",S,W":REM *** DISK SECTION ***
4100 OPEN 8,8,8,NF$
4110 GOSUB 30000
4120 FOR I=0 TO 3
4122 FOR J=0 TO 63:L=64*I+J:PRINT#8,PEEK(SA(I)+J);CHR$(13);:NEXT
4124 NEXT
4130 GOSUB 30000
4140 PRINT#8:CLOSE 8
4150 GOTO 120
4200 OPEN 1,1,1,NF$ :REM *** TAPE SECTION ***
4220 FOR I=0 TO 3
4222 FOR J=0 TO 63:L=64*I+J:PRINT#1,PEEK(SA(I)+J);CHR$(13);:NEXT
4224 NEXT
4240 PRINT#1:CLOSE 1
4243 PRINT "        HIT ANY KEY TO CONTINUE"
4244 GET A$
4246 GET A$:IF A$="" THEN 4246
4250 GOTO 120
4997 :
4998 :
4999 REM *** STORE DVORAK DATA IN KEYBOARD TABLE ***
5000 GOSUB 20000
5002 T=0:REM *** TOTAL FOR DATA CHECK ***
5005 PRINT "         LOADING DVORAK KEYSET"
5050 FOR I=0 TO 194
5070 POKE I+60289,D(I)
5080 T=T+D(I)
5090 NEXT
5095 IF T=22987 THEN 120
5100 PRINT "[147]      DATA ERROR IN DVORAK KEYSET"
5200 FOR I=0 T0 1500:NEXT:REM *** DELAY LOOP ***
5300 GOTO 3300
5399 REM *** SUBROUTINE FOR READING DVORAK DATA ***
5400 FOR I=0 TO 194:READ D(I):NEXT
5410 RETURN
5499 REM *** DVORAK DATA ARRANGED BY KEYNUMBER ***
5500 DATA 20,13,29,136,133,134,135,17,51,44,65,52,59,79,46,1,53,80,69,54,74,85
5510 DATA 89,81,55,70,73,56,88,68,71,75,57,67,72,48,77,84,82,66,43,76,78,45
5520 DATA 86,83,64,87,92,42,58,19,1,61,94,90,49,95,4,50,32,2,47,3,255
5530 DATA 148,141,157,140,137,138,139,145,35,60,193,36,93,207,62,1,37,208,197
5540 DATA 38,202,213,217,209,39,198,201,40,216,196,199,203,41,195,200,48
5550 DATA 205,212,210,194,219,204,206,221,214,211,186,215,169,192,91,147,1
5560 DATA 61,222,218,33,95,4,34,160,2,63,131,255
5570 DATA 148,141,157,140,137,138,139,145,150,60,176,151,93,185,62,1,152
5580 DATA 175,177,153,181,184,183,171,154,187,162,155,189,172,165,161,41
5590 DATA 188,180,48,167,163,178,191,166,182,170,220,190,174,164,179,168,223,91
5600 DATA 147,1,61,222,173,129,95,4,149,160,2,63,131,255
5996 :
5997 :
5998 REM *** DATA FOR ML ROUTINE THAT COPIES BASIC AND KERNAL INTO RAM ***
5999 REM *** CODE USES NO ABSOLUTE ADDRESSES SO MAY BE LOCATED ANYWHERE ***
6000 T=0:FOR I=0 TO 62:READ J:T=T+J:POKE 49152+I,J:NEXT
6010 IF T=10067 GOTO 6099:REM *** TOTAL FOR ML ROUTINE ***
6020 PRINT "[147]      DATA ERROR IN SWAP SUBROUTINE"
6030 FOR I=0 T0 1500:NEXT:REM *** DELAY LOOP ***
6040 GOTO 3300
6099 SYS 49152:RETURN:REM *** SWAP OUT BASIC AND KERNAL ***
6100 DATA 169,0,133,251,169,160,133,252,162,32,160,0,177,251,145,251,136
6110 DATA 240,2,208,247,202,240,4,230,252,208,238,169,0,133,251,169,224,133,252
6120 DATA 162,32,169,0,177,251,145,251,136,240,2,208,247,202,240,4,230,252,208
6130 DATA 238,165,1,41,253,133,1,96
9997 :
9998 :
9999 : REM *** ROUTINE FOR READING IN KEY LABELS ***
10000 FOR I=0 TO 255:READ K$(I):NEXT:RETURN
10001 DATA "DEL","RETURN","CRSR-R","F7","F1","F3","F5","CRSR-D","3"
10002 DATA "W","A","4","Z","S","E","N/A","5","R","D","6","C","F","T","X","7"
10003 DATA "Y","G","8","B","H","U","V","9","I","J","0","M","K","O","N","+","P"
10004 DATA "L","-",".",":","@",",","\","*",";","HOME","N/A","=","^","/"
10005 DATA "1","_","N/A","2","SPACE","N/A","Q","STOP"
10006 DATA "INST","S[146]RETURN","CRSR-L","F8","F2","F4","F6","CRSR-U","#"
10007 DATA "[215]","[193]","$","[218]","[211]","[197]","N/A","%","[210]","[196]","&","[195]","[198]","[212]","[216]","'"
10008 DATA "[217]","[199]","(","[194]","[200]","[213]","[214]",")","[201]","[202]","S[146]0","[205]","[203]","[207]","[206]","[219]"
10009 DATA "[208]","[204]","[221]",">","[","[186]","<","[169]","[192]","]","CLR","N/A","=","[255]","?"
10010 DATA "!","_","N/A","QUOTE","S[146]SPACE","N/A","[209]","RUN"
10011 DATA "C=[146]DEL","C=[146]RETURN","C=[146]CRSR-R","C=[146]F7"
10013 DATA "C=[146]F1","C=[146]F3","C=[146]F5","C=[146]CRSR-D","L.RED"
10015 DATA "[179]","[176]","GRY1","[173]","[174]","[177]","N/A"
10017 DATA "GRY2","[178]","[172]","L.GRN","[188]","[187]","[163]"
10019 DATA "[189]","L.BLU","[183]","[165]","GRY3","[191]"
10021 DATA "[180]","[184]","[190]","RVS-ON","[162]","[181]","RVS-OFF"
10023 DATA "[167]","[161]","[185]","[170]","[166]","[175]","[182]","[220]"
10025 DATA "C=[146].","C=[146]:","[164]","C=[146],","[168]","[223]","C=[146];","C=[146]HOME"
10027 DATA "N/A","C=[146]=","C=[146]^","C=[146]/","ORNG","C=[146]_","N/A"
10029 DATA "BRN","C=[146]SPACE","N/A","[171]","C=[146]STOP"
10032 DATA "C[146]DEL","C[146]RETURN","C[146]CRSR-R"
10033 DATA "C[146]F7","C[146]F1","C[146]F3","C[146]F5","C[146]CRSR-D","RED"
10034 DATA "C[146]W","C[146]A","CYN","C[146]Z","C[146]S","C[146]E","N/A"
10035 DATA "PUR","C[146]R","C[146]D","GRN","C[146]C","C[146]F","C[146]T","C[146]X","BLU"
10036 DATA "C[146]Y","C[146]G","YEL","C[146]B","C[146]H","C[146]U","C[146]V","RVS ON"
10037 DATA "C[146]I","C[146]J","RVS OFF","C[146]M","C[146]K","C[146]O","C[146]N","C[146]+"
10038 DATA"C[146]P","C[146]L","C[146]-","C[146].","C[146]:","C[146]@","C[146],","C[146]\"
10039 DATA"C[146]*","C[146];","C[146]HOME","N/A","C[146]=","C[146]^"
10040 DATA "C[146]/","BLK","C[146]_","N/A","WHT","C[146]SPACE","N/A","C[146]Q"
10041 DATA "C[146]STOP"
10497 :
10498 :
10499 REM *** ROUTINE FOR READING IN NON ECHOING CHARACTERS ***
10500 FOR I=0 TO 66:READ NE$(I)
10501 IFLEFT$(NE$(I),1)="*"THEN NE$(I)="CHR$("+RIGHT$(NE$(I),LEN(NE$(I))-1)+")"
10502 NEXT:RETURN
10505 DATA "*0","*1","*2","*3","*4","WHT","*6","*7"
10510 DATA "DIS C=[146]-S[146]","EN C=[146]-S[146]"
10520 DATA "*10","*11","*12","RETURN","L.CASE","*15"
10530 DATA "*16","CRSR-D","RVS-ON","HOME","DEL","*21","*22","*23"
10540 DATA "*24","*25","*26","*27","RED","CRSR-R","GRN","BLU","SPACE"
10550 DATA "*128","ORNG","*130","*131","*132","F1","F3","F5"
10560 DATA "F7","F2","F4","F6","F8","S[146]RETURN","U.CASE","*143"
10570 DATA "BLK","CRSR-U","RVS-OFF","CLR","INST","BRN","L.RED","GRY1","GRY2"
10580 DATA "L.GRN","L.BLU","GRY3","PUR","CRSR-L","YEL","CYN","S[146]SPACE","QUOTE"
20000 PRINT "[147] KEYDEF:A KEYBOARD REDEFINITION PROGRAM ":RETURN
29997 :
29998 :
29999 REM *** ROUTINE FOR CHECKING DISK ERRORS ***
30000 INPUT#15,E,E$
30020 IF E<20 THEN RETURN
30100 GOSUB 20000
30110 PRINT "      DISK ERROR";E;E$
30120 CLOSE 8
30130 PRINT "        HIT ANY KEY TO CONTINUE"
30135 GET A$
30140 GET A$:IF A$="" THEN 30140
30150 GOTO 120